'
' Pointer Image Editor
'
' Copyright 1986 By Stephen R. Pietrowicz
'
' The author places this software in the 
' public domain.  Please refer to the Amazing
' Computing article accompanying this program
' for more information.
'
' Please do not remove this copyright notice.
'
DECLARE FUNCTION AllocMem&() LIBRARY
DECLARE FUNCTION FreeMem&() LIBRARY
DECLARE FUNCTION ReadPixel&() LIBRARY

LIBRARY "exec.library"
LIBRARY "intuition.library"
LIBRARY "graphics.library"
SCREEN 3,320,200,5,1
WINDOW 3,"Pointer Image Editor by SR Pietrowicz",(0,0)-(309,186),0,3

GOSUB SetUp
'
' Main loop:  Wait until the mouse is clicked
' to do anything.
'
Top:
   WHILE MOUSE(0) = 0:WEND
   x1 = MOUSE(3):y1 = MOUSE(4)
   IF (x1 > 143) THEN CheckDial
   IF (y1 > 143) THEN CheckColor
   x1 = INT(x1/9):y1 = INT(y1/9)
   x2 = x1*9+1: y2 = y1*9+1
   IF cn = 0 THEN
      Ncn = 0
   ELSE
      Ncn = cn+5
   END IF
'
' Set points in both windows, and make sure
' that the "hot spot" stays visible
'    
   LINE(x2,y2)-(x2+8,y2+8),Ncn,bf
   PSET(180+x1,Dial+y1),Ncn
   IF (PFlag = 1) AND (x1 = Psx) AND (y1 = Psy) THEN
       LINE (x2+1,y2+1)-(x2+7,y2+7),11,bf
   END IF
'
' Set the color that was just set in the bitmap
'   
   IF x1 = 0 THEN
      Bit% = &H8000
   ELSE
      Bit% = (2^(15-x1))
   END IF
   
   Sety = Dial-2+y1

   IF (cn/2 = INT(cn/2)) THEN
      Sa%(Sety,0) = Sa%(Sety,0) AND NOT Bit%
   ELSE
      Sa%(Sety,0) = Sa%(Sety,0) OR Bit%
   END IF
   IF (cn < 2) THEN
      Sa%(Sety,1) = Sa%(Sety,1) AND NOT Bit%
   ELSE
      Sa%(Sety,1) = Sa%(Sety,1) OR Bit%
   END IF
        
   WHILE MOUSE(0) <> 0:WEND
GOTO Top
'
' Move the dial, and redraw the pointer window
'
CheckDial:
   IF (x1 < 152) THEN Top
   IF (x1 > 163) THEN CheckRGB
   MENU OFF
   Dbox = Dial
DialTop:
   WHILE MOUSE(0) <> 0
      Dy = MOUSE(6) 
      IF (Dy<2) OR (Dy>141) THEN DialTop
      IF (Dy = Dial) THEN DialTop
      LINE (152,Dial)-(163,Dial+2),0,bf 
      LINE (203,Dial)-(203,Dial+15),0
      Dial = Dy
      LINE (152,Dial)-(163,Dial+2),1,bf
      LINE (203,Dial)-(203,Dial+15),1
   WEND
   IF (Dbox = Dial) THEN 
       MENU ON
       GOTO Top
   END IF
'
' Redraw the pointer window
'
PointRedraw:
   FOR r = 0 TO 15
       By = r*9+1
       Dly = Dial+r
       FOR s = 0 TO 15
           Bx = s*9+1            
           LINE(Bx,By)-(Bx+8,By+8),1,bf
           LINE(Bx,By)-(Bx+8,By+8),POINT(180+s,Dly),bf
       NEXT s
   NEXT r
'
' Check to see if the "Hot Spot" goes in this window
'
   IF LFlag = 1 THEN
      RETURN
   END IF
   IF (Psx >= 0) THEN
      IF (ABS(Dial - Psd) >= 0) AND (ABS(Dial - Psd) <= 15) THEN
          Psy = Psy-(Dial-Psd)
          Psd = Dial
          IF (Psy >= 0) AND (Psy <= 15) THEN
              NPsx = Psx*9+2
              NPsy = Psy*9+2
              LINE(NPsx,NPsy)-(NPsx+6,NPsy+6),11,bf
              PFlag = 1
          ELSE
              PFlag = 0
          END IF
      END IF
  END IF
  MENU ON
  GOTO Top 
'
' Change the color that is being used
'       
CheckColor:
   IF (y1 < 150) OR (y1 > 170) THEN Top
   cn = INT(x1/36)
   LINE (225,Rl)-(240,Rl),0
   LINE (255,Gl)-(270,Gl),0
   LINE (285,Bl)-(300,Bl),0
   IF cn = 0 THEN
      LINE (1,176)-(143,184),0,bf
      Rl = 110:Gl = 110:Bl = 110
   ELSE
      LINE (1,176)-(143,184),cn+5,bf
      Rl = 110 - (RGB!(cn,1)*100)
      Gl = 110 - (RGB!(cn,2)*100)
      Bl = 110 - (RGB!(cn,3)*100)
   END IF
   LINE (225,Rl)-(240,Rl),11
   LINE (255,Gl)-(270,Gl),11
   LINE (285,Bl)-(300,Bl),11
   WHILE MOUSE(0) <> 0 :WEND   
GOTO Top   
'
' Change the Red, Green, Blue values of the
' current color
'
CheckRGB:
    IF (cn = 0) THEN Top
    IF (x1 < 225) OR (x1 > 300) THEN Top
    MENU OFF    
    IF (x1 >= 225) AND (x1 <= 240) THEN Red
    IF (x1 >= 255) AND (x1 <= 270) THEN Green
    IF (x1 >= 285) AND (x1 <= 300) THEN Blue
    MENU OFF
    GOTO Top
Red:
    WHILE MOUSE(0) <> 0
       Ry = MOUSE(6)
       IF (Ry < 10) OR (Ry > 110) THEN Red
       IF (Ry = Rl) THEN Red
       LINE(225,Rl)-(240,Rl),0
       Rl = Ry
       LINE(225,Rl)-(240,Rl),11
       RGB!(cn,1) = (110-Rl)/100
       PALETTE 5+cn, RGB!(cn,1),RGB!(cn,2),RGB!(cn,3)
    WEND
    GOTO EndRGB 
Green:
    WHILE MOUSE(0) <> 0
       Gy = MOUSE(6)
       IF (Gy < 10) OR (Gy > 110) THEN Green
       IF (Gy = Gl) THEN Green
       LINE(255,Gl)-(270,Gl),0       
       Gl = Gy
       LINE(255,Gl)-(270,Gl),11
       RGB!(cn,2) = (110-Gl)/100
       PALETTE 5+cn, RGB!(cn,1),RGB!(cn,2),RGB!(cn,3)
    WEND
    GOTO EndRGB 
Blue:
    WHILE MOUSE(0) <> 0
       By = MOUSE(6)
       IF (By < 10) OR (By > 110) THEN Blue
       IF (By = Bl) THEN Blue
       LINE (285,Bl)-(300,Bl),0
       Bl = By
       LINE (285,Bl)-(300,Bl),11
       RGB!(cn,3) = (110-Bl)/100
       PALETTE 5+cn, RGB!(cn,1),RGB!(cn,2),RGB!(cn,3)
    WEND
EndRGB:
    MENU ON     
GOTO Top
'
' Initialize data structures and 
' variables used by the program
'
SetUp:

TotalHeight% = 156
DIM Sa%(TotalHeight%,1)
DIM RGB!(3,3)
LFlag = 0
'
' Memory allocation has to be 4 times
' the height of the pointer image.
' The second parameter to AllocMem()
' must be 2, to allocate memory in
' the first 512K of memory.
'
MemLength% = TotalHeight% * 4
si& = AllocMem&(MemLength%,2)
IF si& = 0 THEN
   PRINT "Couldn't allocate memory"
   GOTO StopIt
END IF
FOR i = 0 TO TotalHeight%
    Sa%(i,0) = 0
    Sa%(i,1) = 0
NEXT i
'
' Set Up Menus
'
MENU 1,0,1,"Editor"
MENU 1,1,1,"Load  "
MENU 1,2,1,"Save  "
MENU 1,3,1,"Clear "
MENU 1,4,1,"Quit  "
MENU 2,0,1,"Pointer "
MENU 2,1,1,"Test    "
MENU 2,2,1,"Reset   "
MENU 2,3,1,"Hot Spot"
MENU 3,0,1,""
MENU 4,0,1,""
PALETTE 30,1,0,0
Psx = 0:Psy = 0:Psd = 2:PFlag = 1
LINE (2,2)-(8,8),11,bf
ON MENU GOSUB CheckMenu
MENU ON
'
' Pointer drawing box and gadget
'
LINE (0,0)-(145,145),1,b
LINE (150,0)-(165,145),1,b
Dial = 2
LINE (152,Dial)-(163,Dial+2),1,bf
'
' Palette that shows how "real" pointer looks
'
LINE (175,0)-(201,158),1,b
LINE (203,Dial)-(203,Dial+15),1
'
' Draw RGB Settings
'
PALETTE 12,1,0,0
PALETTE 13,0,1,0
PALETTE 14,0,0,1

LINE (220,0)-(305,158),1,b
LINE (223,9)-(242,111),1,b
LINE (253,9)-(272,111),1,b
LINE (283,9)-(302,111),1,b
LINE (225,110)-(240,110),11
LINE (255,110)-(270,110),11
LINE (285,110)-(300,110),11
Rl = 110:Gl = 110:Bl = 110
LINE (223,113)-(242,123),12,bf
LINE (253,113)-(272,123),13,bf
LINE (283,113)-(302,123),14,bf
LOCATE 18,32
PRINT "RGB"
LOCATE 19,30
PRINT "Settings"
'
' Color Box
'
PALETTE 6,1,0,0
PALETTE 7,0,1,0
PALETTE 8,0,0,1
RGB!(1,1) = 1:RGB!(1,2) = 0:RGB!(1,3) = 0
RGB!(2,1) = 0:RGB!(2,2) = 1:RGB!(2,3) = 0
RGB!(3,1) = 0:RGB!(3,2) = 0:RGB!(3,3) = 1

LINE (0,150)-(36,170),1,b
FOR i = 1 TO 3
LINE (i*36,150)-((i+1)*36,170),5+i,bf
NEXT i
LINE (0,175)-(144,185),1,b
'
' Change the system pointer to the
' default program pointer
'
DefaultPointer:
RESTORE
'
' Default program pointer data
'
DATA 14
DATA -1024,0,30720,-32768,12288,-16384
DATA 6144,-8192,3072,-4096,1536,-10240
DATA 768,-29696,384,1536,192,768
DATA 96,384,48,192,24,96
DATA 12,48,4,24,0,8

rp& = WINDOW(7)

READ Ap%
POKEW si&,0
POKEW si&+2,0

Padd = 4
FOR i = 1 TO (Ap%+1)*2
    READ p1%
    POKEW si&+Padd, p1%
    Padd = Padd + 2
NEXT i
POKEW si&+Padd, 0
POKEW si&+Padd+2 ,0

PALETTE 17,1,0,0
PALETTE 18,0.6,0,0
PALETTE 19,0,0.6,0.8

HotX% = 0
HotY% = 0
CALL SetPointer(rp&, si&, Ap%+1,16,HotX%,HotY%)
RETURN    
'
' Menu functions 
'
CheckMenu:

id   = MENU(0)
item = MENU(1)
MENU OFF
'
' Editor
'
IF id = 1 THEN
'
' Load pointer from a file
'
   IF item = 1 THEN
     FileName$ = ""
     GOSUB GetFileName
     IF FileName$ = "" THEN LoadDone
     GOSUB ClearImage
  
     OPEN FileName$ FOR INPUT AS #1
         INPUT #1,RGB!(1,1),RGB!(1,2),RGB!(1,3)
         INPUT #1,RGB!(2,1),RGB!(2,2),RGB!(2,3)
         INPUT #1,RGB!(3,1),RGB!(3,2),RGB!(3,3)
         INPUT #1,Ap%
         FOR j = 0 TO Ap%
             INPUT #1,Sa%(j,0),Sa%(j,1)
         NEXT j
         INPUT #1,Psx, Psy
     CLOSE #1
     Psx = -Psx
     Psy = -Psy
     Psd = INT(Psy/16)*16+2
     Psy = Psy-Psd+2     
 
     PALETTE 6,RGB!(1,1),RGB!(1,2),RGB!(1,3)
     PALETTE 7,RGB!(2,1),RGB!(2,2),RGB!(2,3)
     PALETTE 8,RGB!(3,1),RGB!(3,2),RGB!(3,3)
         
     IF (Psd+Psy <= 15) THEN
         PFlag = 1
     ELSE
         PFlag = 0
     END IF
'
' Reconstruct the colors, and draw them in the palette
'
     FOR Scan = 0 TO Ap%
        Bit% = &H8000
        Bit0% = (Sa%(Scan,0) AND &H8000)/&H8000
        Bit1% = (Sa%(Scan,1) AND &H8000)/&H8000
        cn = (Bit1%*2) OR Bit0%          
        IF cn = 0 THEN
           Ncn = 0
        ELSE
           Ncn = cn+5
        END IF
        PSET(180,Scan+2),Ncn
        FOR j = 14 TO 0 STEP -1
            Bit% = (2^j)
            Bit0% = (Sa%(Scan,0) AND Bit%)/Bit%
            Bit1% = (Sa%(Scan,1) AND Bit%)/Bit%
            cn = (Bit1%*2) OR Bit0%          
            IF cn = 0 THEN
               Ncn = 0
            ELSE
               Ncn = cn+5
            END IF
            PSET(195-j,Scan+2),1
            PSET(195-j,Scan+2),Ncn
        NEXT j
     NEXT Scan
'
' Recontruct the main drawing area
' and reset the intuition pointer
'
     LFlag = 1
     GOSUB PointRedraw
     IF (PFlag = 1) THEN
         LINE (Psx*9+2,Psy*9+2)-(Psx*9+8,Psy*9+8),11,bf
     END IF
     LFlag = 0
LoadDone:     
     MENU ON
     RETURN
   END IF
'
' Save current pointer to a file
'   
   IF item = 2 THEN
'
' Make sure there is a pointer to save...
'      
     Ap% = 156
     PSFlag = 1
     WHILE  (PSFlag = 1)
         IF (Ap% < 0) THEN
             PSFlag = 0
         ELSEIF (Sa%(Ap%,0) <> 0) OR (Sa%(Ap%,1) <> 0) THEN
             PSFlag = 0
         ELSE 
             Ap% = Ap% - 1
         END IF
     WEND
     IF (Ap% < 0) THEN
        LOCATE 21,20
        PRINT "No pointer! Hit ESC "
        GOTO SaveBad
     END IF

     FileName$ = ""
     GOSUB GetFileName
     IF FileName$ = "" THEN SaveDone
     
     OPEN FileName$ FOR OUTPUT AS #1
         WRITE #1,RGB!(1,1),RGB!(1,2),RGB!(1,3)
         WRITE #1,RGB!(2,1),RGB!(2,2),RGB!(2,3)
         WRITE #1,RGB!(3,1),RGB!(3,2),RGB!(3,3)
         WRITE #1,Ap%
         FOR j = 0 TO Ap%
             WRITE #1,Sa%(j,0),Sa%(j,1)
         NEXT j
         WRITE #1,-Psx, -(Psy+Psd-2)
     CLOSE #1
     GOTO SaveDone
SaveBad:
     Key$ = INKEY$: IF Key$ = "" THEN SaveBad
     IF ASC(Key$) <> 27 THEN SaveBad
     LOCATE 21,20
     PRINT "                    "  
SaveDone:     
     MENU ON
     RETURN
   END IF
'
' Clear current pointer bitmap and drawing areas 
'

   IF item = 3 THEN
ClearImage:
      FOR i = 0 TO 156
         Sa%(i,0) = 0
         Sa%(i,1) = 0
      NEXT i
      LINE (1,1)-(144,144),0,bf
      LINE (152,Dial)-(163,Dial+2),0,bf 
      LINE (152,2)-(163,4),1,bf
      LINE (203,Dial)-(203,Dial+15),0
      Dial = 2
      LINE (176,1)-(200,157),0,bf
      LINE (203,2)-(203,17),1
      Psx = 0:Psy = 0:Psd = 2:PFlag = 1
      LINE (2,2)-(8,8),11,bf
      MENU ON
      RETURN
   END IF
'
' Quit
'
   IF item = 4 THEN
      GOTO StopIt
   END IF
END IF
'
' Pointer functions
'
IF id = 2 THEN
'
' Use the current pointer image
'
   IF item = 1 THEN
      GOSUB SetIt
      MENU ON
      RETURN
   END IF
'
' Reset the pointer in use to the default pointer
'
   IF item = 2 THEN
      GOSUB DefaultPointer 
      MENU ON
      RETURN
   END IF
'
' Set the pointer's "Hot Spot"
'
   IF item = 3 THEN
PickSet:
      WHILE MOUSE(0) = 0:WEND
      x1 = MOUSE(3):y1 = MOUSE(4)
      IF x1>143 OR y1>143 THEN PickSet
      x1 = INT(x1/9):y1 = INT(y1/9)
      x2 = x1*9+2: y2 = y1*9+2
      IF (PFlag = 1) THEN
         NPsx = Psx*9+2
         NPsy = Psy*9+2
         Pc = POINT(NPsx-1,NPsy-1)
         IF (Pc <> 0) THEN
             LINE(NPsx,NPsy)-(NPsx+6,NPsy+6),Pc,bf
         ELSE
             LINE(NPsx,NPsy)-(NPsx+6,NPsy+6),0,bf
         END IF
      END IF
      LINE(x2,y2)-(x2+6,y2+6),11,bf
      Psx = x1
      Psy = y1
      Psd = Dial
      PFlag = 1
      WHILE MOUSE(0) <> 0:WEND
      ON MENU GOSUB CheckMenu
      MENU ON
      RETURN
   END IF
END IF

RETURN

END
'
' Subroutine to return FileName$
'   FileName$ is limited to 17 characters
'   Hitting the escape key exits with a
'   NULL value
'
GetFileName:
   LOCATE 21,20
   PRINT "Input file Name:"
   LINE(150,173)-(300,185),1,b
   
   Key$ = INKEY$
   WHILE Key$<>"":Key$ = INKEY$:WEND
   
   Box = 152
   LINE(Box,175)-(Box+7,183),30,bf
   Cursor = 20
   LOCATE 23,Cursor
NameTop:
   Key$ = INKEY$:IF Key$ = "" THEN NameTop
   NameLen = LEN(FileName$)
   IF (ASC(Key$) = 27) THEN 
       FileName$ = ""
       GOTO NameDone
   END IF
   IF (ASC(Key$) = 13) AND (NameLen <>0) THEN NameDone
   IF (ASC(Key$) =  8) AND (NameLen > 0) THEN
       FileName$ = LEFT$(FileName$,NameLen-1)
       LINE (Box,175)-(Box+7,183),0,bf
       Box = Box-8
       LINE (Box,175)-(Box+7,183),30,bf
       GOTO NameTop
   END IF
   IF (NameLen >= 17) THEN NameTop
   IF ((Key$ >= "0") AND (Key$ <= "9")) THEN NameAdd
   IF ((Key$ >= "A") AND (Key$ <= "Z")) THEN NameAdd
   IF ((Key$ >= "a") AND (Key$ <= "z")) THEN NameAdd
   GOTO NameTop
NameAdd:
   FileName$ = FileName$ + Key$
   LINE (Box,175)-(Box+7,183),0,bf
   LOCATE 23,20+NameLen
   PRINT Key$;
   Box = Box+8
   LINE (Box,175)-(Box+7,183),30,bf
   GOTO NameTop
   
NameDone: 
   LOCATE 21,20
   PRINT "                "
   LINE(150,173)-(300,185),0,bf
RETURN
END
'
' User the pointer image on the palette as
' the default pointer
'
SetIt:
     Ap% = 156
     PSFlag = 1
     WHILE  (PSFlag = 1)
         IF (Ap% < 0) THEN
             PSFlag = 0
         ELSEIF (Sa%(Ap%,0) <> 0) OR (Sa%(Ap%,1) <> 0) THEN
             PSFlag = 0
         ELSE
             Ap% = Ap% - 1
         END IF
     WEND
IF (Ap% < 0) THEN
    RETURN
END IF
    
POKEW si&, 0
POKEW si&+2, 0

Padd = 4
FOR j = 0 TO Ap%+1
   POKEW (si&+Padd), Sa%(j,0)
   Padd = Padd + 2
   POKEW (si&+Padd), Sa%(j,1)
   Padd = Padd + 2
NEXT j
POKEW si&+Padd, 0
POKEW si&+Padd+2 ,0

PALETTE 17,RGB!(1,1),RGB!(1,2),RGB!(1,3)
PALETTE 18,RGB!(2,1),RGB!(2,2),RGB!(2,3)
PALETTE 19,RGB!(3,1),RGB!(3,2),RGB!(3,3)

Spx% = -Psx: Spy% = -(Psy+Psd-2)
CALL SetPointer(rp&, si&, Ap%+2,16,Spx%,Spy%)
RETURN
'
' Clean up the loose ends, and exit 
'
StopIt:

WINDOW CLOSE 3
SCREEN CLOSE 3

CALL FreeMem(si&,MemLength%)

LIBRARY CLOSE

END